Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Const ERROR_SUCCESS = 0&
Const REG_SZ = 1 ' Unicode nul terminated String
Const REG_DWORD = 4 ' 32-bit number
Public Enum HKeyTypes
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
End Enum
Private Declare Function ClipCursor Lib "user32" _
(lpRect As Any) As Long
Private Declare Function OSGetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Declare Function OSGetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function OSGetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function OSWritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Private Declare Function OSWritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function OSGetProfileInt Lib "kernel32" Alias "GetProfileIntA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Long) As Long
Private Declare Function OSGetProfileSection Lib "kernel32" Alias "GetProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function OSGetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function OSWriteProfileSection Lib "kernel32" Alias "WriteProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String) As Long
Private Declare Function OSWriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Const nBUFSIZEINI = 1024
Private Const nBUFSIZEINIALL = 4096
Private FilePathName As String
Public Sub CleanUpSystray()
Shell_NotifyIcon NIM_DELETE, nid
End Sub
Public Sub SaveSettings()
Dim fFile As Integer
fFile = FreeFile
'save settings
Open App.Path & "\Settings.inf" For Output As fFile
Print #fFile, "[settings]"
Print #fFile, "monthly=" & Option1.Value
Print #fFile, "weekly=" & Option2.Value
Print #fFile, "daily=" & Option3.Value
Print #fFile, "hourly=" & Option4.Value
Print #fFile, "startup=" & Option5.Value
Print #fFile, "nochange=" & Option6.Value
Print #fFile, "preview=" & Check1.Value
Print #fFile, "random=" & Check4.Value
Print #fFile, "launchatstartup=" & Check2.Value
Print #fFile, "minimize=" & Check3.Value
Print #fFile, "lastpic=" & List1.ListIndex
Print #fFile, "sdate=" & LblDate.Caption
Print #fFile, "stime=" & LblTime.Caption
Close fFile
DoEvents
End Sub
Public Sub List_Add(list As ListBox, txt As String)
On Error Resume Next
List1.AddItem txt
End Sub
Public Sub List_Load(thelist As ListBox, FileName As String)
'Loads a file to a list box
On Error Resume Next
Dim TheContents As String
Dim fFile As Integer
fFile = FreeFile
Open FileName For Input As fFile
Do
Line Input #fFile, TheContents$
If TheContents$ = "" Then
Else
Call List_Add(List1, TheContents$)
End If
Loop Until EOF(fFile)
Close fFile
End Sub
Public Sub List_Save(thelist As ListBox, FileName As String)
'Save a listbox as FileName
On Error Resume Next
Dim Save As Long
Dim fFile As Integer
fFile = FreeFile
Open FileName For Output As fFile
For Save = 0 To thelist.ListCount - 1
Print #fFile, List1.list(Save)
Next Save
Close fFile
End Sub
Private Sub SetPicture(ByVal FileName As String)
On Error GoTo Dawm
Dim xFile As String
xFile = WinPath & "CS WallPaper.bmp"
SavePicture picScreen.Picture, xFile
SystemParametersInfo SPI_SETDESKWALLPAPER, 0&, ByVal xFile, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE
Me.Label1.Caption = "Total Wallpapers in list: " & List1.ListCount
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
Dim xxx As Date
Dim yyy As Date
xxx = LblDate.Caption
yyy = LblTime.Caption
If Option1.Value = True Then
Timer2.Enabled = True
If xxx <= Date Then
If Check4.Value = 1 Then
List1.ListIndex = Int(Rnd * List1.ListCount)
Else
If List1.ListIndex = List1.ListCount - 1 Then
List1.ListIndex = 0
Else
List1.ListIndex = List1.ListIndex + 1
End If
End If
LblDate = Date + 30
DoEvents
Call Command3_Click
End If
End If
If Option2.Value = True Then
Timer2.Enabled = True
If xxx <= Date Then
If Check4.Value = 1 Then
List1.ListIndex = Int(Rnd * List1.ListCount)
Else
If List1.ListIndex = List1.ListCount - 1 Then
List1.ListIndex = 0
Else
List1.ListIndex = List1.ListIndex + 1
End If
End If
LblDate = Date + 7
DoEvents
Call Command3_Click
End If
End If
If Option3.Value = True Then
Timer2.Enabled = True
If xxx <= Date Then
If Check4.Value = 1 Then
List1.ListIndex = Int(Rnd * List1.ListCount)
Else
If List1.ListIndex = List1.ListCount - 1 Then
List1.ListIndex = 0
Else
List1.ListIndex = List1.ListIndex + 1
End If
End If
LblDate = Date + 1
DoEvents
Call Command3_Click
End If
End If
If Option4.Value = True Then
Timer2.Enabled = True
If yyy <= Time Then
If Check4.Value = 1 Then
List1.ListIndex = Int(Rnd * List1.ListCount)
Else
If List1.ListIndex = List1.ListCount - 1 Then
List1.ListIndex = 0
Else
List1.ListIndex = List1.ListIndex + 1
End If
End If
LblTime.Caption = DateAdd("h", 1, Time)
DoEvents
Call Command3_Click
End If
End If
If Option5.Value = True Then
Timer2.Enabled = False
If Check4.Value = 1 Then
List1.ListIndex = Int(Rnd * List1.ListCount)
Else
If List1.ListIndex = List1.ListCount - 1 Then
List1.ListIndex = 0
Else
List1.ListIndex = List1.ListIndex + 1
End If
End If
Call Command3_Click
End If
End Sub
Private Function GetPrivateProfileString(ByVal szSection As String, ByVal szEntry As Variant, ByVal szDefault As String, ByVal szFileName As String) As String
' *** Get an entry in the inifile ***
Dim szTmp As String
Dim nRet As Long
If (IsNull(szEntry)) Then
' *** Get names of all entries in the named Section ***
(.txt)